home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / ARISOURC.ZIP / F48FATN.ASM next >
Assembly Source File  |  1993-01-24  |  8KB  |  171 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 6.0        *
  5. ; *     Real ArcTan                                     *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1992 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   F48FATN
  12.  
  13.              INCLUDE SE.ASM
  14.  
  15.  
  16. CODE         SEGMENT BYTE PUBLIC
  17.  
  18.              ASSUME  CS:CODE
  19.  
  20. ; Externals
  21.  
  22.              EXTRN   RealAdd:NEAR,RealPoly:NEAR,RealTrunc:NEAR,RealFloat:NEAR
  23.              EXTRN   RealDivRev:NEAR,RealMulNChk2:NEAR,CmpAbsValue:NEAR
  24.              EXTRN   ShortMulRev:NEAR
  25.  
  26. ; Publics
  27.  
  28.              PUBLIC  RArcTan
  29.  
  30. ;-------------------------------------------------------------------------------
  31. ; RArcTan computes the arctangent of a TURBO-Pascal six byte floating-point
  32. ; number. No overflow is possible, since function values range from -pi/2 to
  33. ; pi/2. The argument is reduced such that |z| <= 1/16 by an interval scheme
  34. ; based on the identity Arctan (x) = Arctan (a) + Arctan ((x-a) / (1 + x*a)).
  35. ; The arctangent of the reduced argument is then computed using a fast poly-
  36. ; nomial approximation. The result is finally adjusted depending on which
  37. ; reduction interval the argument was in. This polynomial approximation to the
  38. ; arctangent is used:
  39. ;
  40. ; p(z):=((-1.420288085938e-1*x^2+1.999981270101e-1)*x^2
  41. ;         -3.333333321307e-1)*x^2*x+x
  42. ;
  43. ; This approximation has a theoretical maximum relative error of 2.98e-13.
  44. ; Maximum observed error when evaluated in REAL arithmetic is 1.11e-12.
  45. ;
  46. ; INPUT:     DX:BX:AX  argument
  47. ;
  48. ; OUTPUT:    DX:BX:AX  arctan of argument
  49. ;
  50. ; DESTROYS:  AX,BX,CX,DX,SI,DI,Flags
  51. ;-------------------------------------------------------------------------------
  52.  
  53. RArcTanExt   PROC    FAR
  54. $atn_x:      RET                       ; return zero
  55. RArcTanExt   ENDP
  56.  
  57.              ALIGN   4
  58.  
  59. RArcTan      PROC    FAR
  60.              CMP     AL, 06Dh          ; x very small ?
  61.              JB      $atn_x            ; yes, return x
  62.              PUSH    BP                ; save TURBO-Pascal frame pointer
  63.              MOV     CH, 80h           ; load mask for sign bit
  64.              AND     CH, DH            ; isolate sign bit
  65.              XOR     DH, CH            ; absolute value of x
  66.              PUSH    CX                ; save sign bit
  67.              MOV     CX, 81h           ; load
  68.              XOR     SI, SI            ;  floating
  69.              MOV     DI, SI            ;   constant 1
  70.              CALL    CmpAbsValue       ; x <= 1 ?
  71.              PUSHF                     ; save division flag
  72.              JB      $no_division      ; x <= 1, no division
  73.              CALL    RealDivRev        ; compute x = 1/x
  74. $no_division:MOV     DI, DX            ; save
  75.              MOV     SI, BX            ;  x
  76.              PUSH    AX                ;
  77.              ADD     AL, 3             ; x * 8
  78.              MOV     CH, 0FFh          ; signal rounding desired
  79.              CALL    RealTrunc         ; n = Round (x * 8)
  80.              MOV     BP, AX            ; save n
  81.              POP     CX                ; DI:SI:CX = x
  82.              OR      AX, AX            ; n = 0 ?
  83.              MOV     DX, DI            ; reload x
  84.              MOV     BX, SI            ;  into
  85.              XCHG    AX, CX            ;   DX:BX:AX
  86.              JZ      $atn_appr         ; n=0, evaluate approximating polynomial
  87.              XCHG    AX, CX            ; AX=n, CX = LSW of x
  88.              PUSH    AX                ; save n
  89.              PUSH    CX                ; save LSW of x
  90.              CWD                       ; convert n to longint (n <= 8)
  91.              CALL    RealFloat         ; convert n to REAL
  92.              POP     CX                ; get LSW of x
  93.              SUB     AL, 3             ; n/8
  94.              MOV     BP, AX            ; save
  95.              MOV     AH, DH            ; AX = packed n
  96.              XCHG    AX, BP            ; BP = packed n
  97.              XOR     DH, 80h           ; -n/8
  98.              PUSH    DI                ; save
  99.              PUSH    SI                ;  x
  100.              PUSH    CX                ; save x
  101.              CALL    RealAdd           ; x - n/8
  102.              POP     CX                ; get
  103.              POP     SI                ;  x
  104.              POP     DI                ;   from stack
  105.              PUSH    DX                ; save x - n/8
  106.              PUSH    BX                ;  on
  107.              PUSH    AX                ;   stack
  108.              MOV     AX, BP            ; get packed floating point n
  109.              XOR     DX, DX            ; unpack
  110.              MOV     BX, DX            ;  floating point
  111.              XCHG    AH, DH            ;   n
  112.              CALL    ShortMulRev       ; x * n
  113.              MOV     CX, 81h           ; load
  114.              XOR     SI, SI            ;  real constant
  115.              MOV     DI, SI            ;   1.0
  116.              CALL    RealAdd           ; compute 1 + x*n/8
  117.              POP     CX                ; get
  118.              POP     SI                ;  back
  119.              POP     DI                ;   x - n/8
  120.              CALL    RealDivRev        ; compute (x - n/8) / (1 + x*n/8)
  121.              POP     BP                ; get integer n
  122.              MOV     CX, BP            ; compute
  123.              ADD     CX, CX            ;  offset into
  124.              ADD     BP, CX            ;   constant field
  125.              ADD     BP, BP            ;    as 6*n
  126.              ADD     BP, OFFSET ATN_CST; address of constant B for interval n
  127. $atn_appr:   MOV     CX, 3             ; approximation uses three coefficients
  128.              XOR     SI, SI            ; polynomial of type P(x²)*x+x
  129.              MOV     DI,OFFSET AT_COEFF; pointer to first coefficient
  130.              CALL    RealPoly          ; compute arctan (z) = z + z * P(z)
  131.              CMP     BP, OFFSET ATN_CST+6; first or second interval ?
  132.              JB      $first_intv       ; first interval, no correction needed
  133.              JNE     $normal_add       ; not second interval, no special add
  134.              MOV     CX, 03365h        ; add eps for second interval
  135.              MOV     SI, 07B6Eh        ;  for a pseudo
  136.              MOV     DI, 05561h        ;   multiple precision
  137.              CALL    RealAdd           ;    addition
  138. $normal_add: MOV     CX, CS:[BP-6]     ; load value
  139.              MOV     SI, CS:[BP-4]     ;  of constant B appropriate
  140.              MOV     DI, CS:[BP-2]     ;   for reduction interval
  141.              CALL    RealAdd           ; add B to arctan (z)
  142. $first_intv: POPF                      ; get flag for division
  143.              JB      $no_add           ; if no division then done
  144.              MOV     CX, 02181h        ; load
  145.              MOV     SI, 0DAA2h        ;  real constant
  146.              MOV     DI, 0490Fh        ;   0.5*pi
  147.              XOR     DH, 80h           ; - arctan (z)
  148.              CALL    RealAdd           ; compute 0.5*pi - arctan (z)
  149. $no_add:     POP     CX                ; get sign mask
  150.              POP     BP                ; restore TURBO-Pascal frame pointer
  151.              OR      DH, CH            ; make sign bit
  152.              RET                       ; done
  153. ATN_CST      DB      07Dh,000h,000h,0D4h,0ADh,07Eh ; arctan (1/8) - eps
  154.              DB      07Eh,064h,0C9h,0AFh,0DBh,07Ah ; arctan (2/8)
  155.              DB      07Fh,027h,00Fh,0CAh,0B0h,037h ; arctan (3/8)
  156.              DB      07Fh,00Eh,02Bh,038h,063h,06Dh ; arctan (4/8)
  157.              DB      080h,0F8h,05Eh,05Dh,000h,00Fh ; arctan (5/8)
  158.              DB      080h,035h,019h,07Dh,0BCh,024h ; arctan (6/8)
  159.              DB      080h,0C2h,02Bh,03Eh,005h,038h ; arctan (7/8)
  160.              DB      080h,021h,0A2h,0DAh,00Fh,049h ; arctan (8/8)
  161. AT_COEFF     DB      07Eh,               070h,091h ; -1.420288085938e-1
  162.              DB      07Eh,014h,01Bh,04Fh,0CCh,04Ch ;  1.999981270101e-1
  163.              DB      07Fh,056h,0A0h,0AAh,0AAh,0AAh ; -3.3